home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / misc / amag / sh9301b.lha / RG-3-D(S.14) / rgdemo.mod < prev    next >
Text File  |  1993-01-12  |  16KB  |  420 lines
  1. MODULE RGDemo;
  2.  
  3. FROM SYSTEM    IMPORT ADDRESS,ADR,INLINE,FFP;
  4. FROM Intuition IMPORT NewWindow,IDCMPFlags,IDCMPFlagSet,ScreenPtr,WindowPtr,
  5.               WindowFlags,WindowFlagSet,NewScreen,customScreen,
  6.               OpenScreen,CloseScreen,OpenWindow,CloseWindow,
  7.               ScreenFlags,ScreenFlagSet,IntuiMessagePtr,ScreenToFront;
  8. FROM Graphics  IMPORT AllocRaster,TmpRas,AreaInfo,AreaEllipse,AreaMove,Text,
  9.               AreaDraw,AreaEnd,BitMap,InitBitMap,ViewModeSet,ViewModes,
  10.               FreeRaster,DrawEllipse,SetRast,Move,InitArea,InitTmpRas,
  11.               LoadRGB4,SetAPen,InitRastPort,RastPort,RastPortPtr,Draw;
  12. FROM GfxMacros IMPORT SetWrMsk,SetOPen;
  13. FROM Exec      IMPORT GetMsg,ReplyMsg;
  14. FROM InOut     IMPORT WriteString,WriteLn;
  15. FROM Arts      IMPORT TermProcedure;
  16. FROM RandomNumber IMPORT RND,PutSeed;
  17. FROM MathLibFFP   IMPORT sin,cos,pi;
  18.  
  19. CONST     rotsteps      = 360; (* Anzahl der Rot.schritte der Würfelanimation *)
  20.           p        = 0.2; (* Perspekt. Verkürzungsfaktor *)
  21.           alfa        = -70.0*pi/180.0; (* Winkel, unter dem die Rotations-
  22.                                           ebene der Würfelanim. gesehen wird  *)
  23.       dphi         = pi/180.0; (* Rotationswinkel-Inkrement *)
  24.         XShift     = 320; (* Offset, um die Animation in die Bildschirm- *)
  25.         YShift    = 128; (* mitte zu rücken *)
  26.         ZFocus    = 1000.0; (* z-Koord. d. Fluchtpunktes (0|0|ZFocus) *)
  27.  
  28. TYPE      Ecken        = ARRAY[1..8],[1..3] OF FFP;
  29.       FlaechenIndex    = ARRAY[1..6] OF INTEGER;
  30.           ZvonFCenter    = ARRAY[1..6] OF FFP;
  31.  
  32. VAR RGWindow        : NewWindow;
  33.     RGScreen          : NewScreen;
  34.     RGWindowPtr0    : WindowPtr;
  35.     RGScreenPtr0    : ScreenPtr;
  36.     RGWindowPtr1    : WindowPtr;
  37.     RGScreenPtr1    : ScreenPtr;
  38.     RGWinRPPtr0        : RastPortPtr;
  39.     RGWinRPPtr1        : RastPortPtr;
  40.     RGRPPtr        : RastPortPtr;
  41.     Buffer          : ARRAY[0..49] OF CARDINAL;
  42.     AreaMemPtr      : ADDRESS;
  43.     RGDemoTmpRas    : TmpRas;
  44.     RGDemoAreaInfo    : AreaInfo;
  45.     IntuiMsg,IntuiMsg1    : IntuiMessagePtr;
  46.     ok,EX,ausserhalb    : BOOLEAN;
  47.     class        : IDCMPFlagSet;
  48.  
  49.     WP1org        :    Ecken; (* Ecken d. 1.Würfels  original      *)
  50.     WP1             :    Ecken; (*                     transformiert *)
  51.     WP2org        :    Ecken; (*          2.         original      *)
  52.     WP2             :    Ecken; (*                     transformiert *)
  53.     F            :    ARRAY[1..6],[1..5] OF INTEGER; (* Würf.flächn *)
  54.     FIndexW1        :     FlaechenIndex; (* Numerierung der Flächen *)
  55.     FIndexW2        :    FlaechenIndex;
  56.     ZFCW1        :    ZvonFCenter; (* z-Koordinaten der Würf.flächn *)
  57.     ZFCW2        :    ZvonFCenter;
  58.     Trafo        :    ARRAY[1..3],[1..3] OF FFP; (* Rot. matrix *)
  59.     ARInt        :    ARRAY[1..108*rotsteps] OF INTEGER; (* Animat.*)
  60.     I1            :    LONGINT; (* Index für ARInt *)
  61.     RGDelta        :    FFP;     (* Faktor für Rot/Grün-Versatz *)
  62.  
  63. PROCEDURE CloseDown ; (* räumt zum Schluß alles auf *)
  64. VAR i,j        :    INTEGER;
  65. BEGIN (* CloseDown *)
  66.       IF RGWindowPtr0 # NIL THEN CloseWindow(RGWindowPtr0); END;
  67.       IF RGScreenPtr0 # NIL THEN CloseScreen(RGScreenPtr0); END;
  68.       IF RGWindowPtr1 # NIL THEN CloseWindow(RGWindowPtr1); END;
  69.       IF RGScreenPtr1 # NIL THEN CloseScreen(RGScreenPtr1); END;
  70.       IF AreaMemPtr # NIL THEN   FreeRaster(AreaMemPtr,640,256); END;
  71. END CloseDown ;
  72.  
  73. PROCEDURE Okay(text : ARRAY OF CHAR ; adr : ADDRESS):BOOLEAN ;
  74. BEGIN (* Okay *)
  75.   IF adr = NIL THEN
  76.      WriteString(text);WriteString(" läßt sich nicht oeffnen !!") ; WriteLn ;
  77.      WriteString(" ProgrammABBRUCH") ; WriteLn ; RETURN(FALSE);
  78.   ELSE RETURN(TRUE); END (* IF *) ;
  79. END Okay ;
  80.  
  81. PROCEDURE InitOberfl; (* initialisiert 2 Screens etc. für DoubleBuffering *)
  82. VAR i,j :INTEGER;
  83. BEGIN
  84.    RGScreenPtr0:=NIL; RGWindowPtr0:=NIL;
  85.    RGScreenPtr1:=NIL; RGWindowPtr1:=NIL; AreaMemPtr:=NIL;
  86.  
  87.    WITH RGScreen DO
  88.       leftEdge := 0 ; topEdge := 0 ; width := 640 ; height := 256 ; depth := 4 ;
  89.       detailPen := 0 ; blockPen := 1 ; viewModes := ViewModeSet{hires} ;
  90.       type := customScreen; font := NIL ; defaultTitle :=ADR("NIL");
  91.       gadgets := NIL ; customBitMap := NIL;
  92.    END (* WITH *) ;
  93.  
  94.    RGScreenPtr0 := OpenScreen(RGScreen) ;
  95.    IF NOT Okay("RGScreen",RGScreenPtr0) THEN CloseDown;HALT;END;
  96.  
  97.    WITH RGWindow DO
  98.     leftEdge:=0; topEdge:=1; width:=640; height:=255;
  99.     detailPen:=9; blockPen:=15; idcmpFlags:=IDCMPFlagSet{closeWindow};
  100.     flags:=WindowFlagSet{windowClose,gimmeZeroZero,activate};
  101.     firstGadget:=NIL; checkMark:=NIL; title:=ADR("Rot-Grün-3D-Demo 0");
  102.     bitMap:=NIL; type:=customScreen; screen:= RGScreenPtr0; minWidth:=600;
  103.     maxWidth:=640; minHeight:=256; maxHeight:=256;
  104.   END;
  105.  
  106.   RGWindowPtr0:=OpenWindow(RGWindow);
  107.   IF NOT Okay("RGWindow",RGWindowPtr0) THEN CloseDown;HALT;END;
  108.   RGWinRPPtr0:=RGWindowPtr0^.rPort;
  109.  
  110.   RGScreenPtr1 := OpenScreen(RGScreen) ;
  111.   IF NOT Okay("RGScreen",RGScreenPtr1) THEN CloseDown;HALT;END;
  112.  
  113.   WITH RGWindow DO
  114.     title:=ADR("Rot-Grün-3D-Demo 1"); screen:= RGScreenPtr1;
  115.   END;
  116.  
  117.   RGWindowPtr1:=OpenWindow(RGWindow);
  118.   IF NOT Okay("RGWindow",RGWindowPtr1) THEN CloseDown;HALT;END;
  119.   RGWinRPPtr1:=RGWindowPtr1^.rPort;
  120.  
  121.   RGRPPtr:=RGWinRPPtr0;
  122.  
  123.   AreaMemPtr:=AllocRaster(640,256);
  124.   IF NOT Okay("AreaMem",AreaMemPtr) THEN CloseDown; HALT;END;
  125.   FOR i:=0 TO 49 DO Buffer[i]:=0;END;
  126.   InitArea(RGDemoAreaInfo,ADR(Buffer),20);   (* AreaInfo initialisieren *)
  127.   InitTmpRas(RGDemoTmpRas,AreaMemPtr,20480); (* TmpRas initialisieren *)
  128.   RGWinRPPtr0^.tmpRas:=ADR(RGDemoTmpRas);    (* TmpRas übergeben *)
  129.   RGWinRPPtr0^.areaInfo:=ADR(RGDemoAreaInfo);(* AreaInfo übergeben *)
  130.   RGWinRPPtr1^.tmpRas:=ADR(RGDemoTmpRas);    (* TmpRas übergeben *)
  131.   RGWinRPPtr1^.areaInfo:=ADR(RGDemoAreaInfo);(* AreaInfo übergeben *)
  132.  
  133.   PutSeed(2);
  134. END  InitOberfl;
  135.  
  136. PROCEDURE FarbTabelle;(* $E- *)
  137. BEGIN
  138.    INLINE(0007H,0057H,0077H,0097H,
  139.           0507H,0557H,0577H,0597H,
  140.           0707H,0757H,0777H,0797H,
  141.           0907H,0957H,0977H,0997H);
  142. END FarbTabelle;
  143.  
  144. PROCEDURE FarbTabelleLaden;
  145. BEGIN
  146.  LoadRGB4(ADR(RGWindowPtr0^.wScreen^.viewPort),ADR(FarbTabelle),16);
  147.  LoadRGB4(ADR(RGWindowPtr1^.wScreen^.viewPort),ADR(FarbTabelle),16)
  148. END FarbTabelleLaden;
  149.  
  150. PROCEDURE ScheibenZeichnen;
  151. VAR i,k,r,x,y,deltarot,deltagruen,max    :    INTEGER;
  152.     Pen                    :    CARDINAL;
  153. BEGIN
  154.   max:=20;
  155.   FOR i:=1 TO 2*max DO
  156.       ausserhalb:=TRUE;
  157.       WHILE ausserhalb DO
  158.         x:=1+RND(640);y:=1+RND(256);
  159.         IF i<max THEN deltarot:=max-i;deltagruen:=0;k:=max-i;r:=20+i DIV 2;
  160.         ELSE          deltarot:=0;deltagruen:=i-max;k:=i-max;r:=20+i DIV 2;
  161.         END;
  162.         IF  (2+2*r+k<x) AND (638-2*r>x)
  163.         AND (2+r    <y) AND (240-r    >y) THEN
  164.            ausserhalb:=FALSE;
  165.         END;
  166.       END;
  167.       Pen:=5*CARDINAL(RND(3)+1);
  168.  
  169.       FOR k:=0 TO 49 DO Buffer[k]:=0;END;
  170. (* rote Ansicht zeichnen *)
  171.       SetAPen(RGWinRPPtr1,Pen); SetWrMsk(RGWinRPPtr1,0F3H);
  172.       ok:=AreaEllipse(RGWinRPPtr1,x-deltarot,y,2*r,r);
  173.       ok:=AreaEnd(RGWinRPPtr1);
  174.       SetAPen(RGWinRPPtr1,0);
  175.       DrawEllipse(RGWinRPPtr1,x-deltarot,y,2*r,r);
  176. (* grüne Ansicht zeichnen *)
  177.       SetAPen(RGWinRPPtr1,Pen);SetWrMsk(RGWinRPPtr1,0FCH);
  178.       FOR k:=0 TO 49 DO Buffer[k]:=0;END;
  179.       ok:=AreaEllipse(RGWinRPPtr1,x-deltagruen,y,2*r,r);
  180.       ok:=AreaEnd(RGWinRPPtr1);
  181.       SetAPen(RGWinRPPtr1,0);
  182.       DrawEllipse(RGWinRPPtr1,x-deltagruen,y,2*r,r)
  183.   END;
  184.   SetWrMsk(RGWinRPPtr1,0FFH);SetAPen(RGWinRPPtr1,15);
  185.   Move(RGWinRPPtr1,20,10);Text(RGWinRPPtr1,ADR
  186. ("AMIGA berechnet jetzt die Würfelanimation, bitte ca. 2 min. warten..."),69);
  187. END ScheibenZeichnen;
  188.  
  189. PROCEDURE AnimWuerfel;
  190. VAR i,j,k,n        :    INTEGER;
  191.     m            :    LONGINT;
  192.  
  193. PROCEDURE QuickSort(l,r:CARDINAL;VAR Wt:ZvonFCenter;VAR FI:FlaechenIndex);
  194. (* sortiert für die Hiddenline Darstellung die Flächen nach der z-Koordinate
  195.    des Flächenzentrums *)
  196. VAR i,j        :    CARDINAL;
  197.     Ind        :    INTEGER;
  198.     x,y        :    FFP;
  199. BEGIN
  200.  i:=l;j:=r; x:=Wt[(l+r) DIV 2];
  201.  REPEAT
  202.    WHILE Wt[i]<x DO INC(i) END; WHILE x<Wt[j] DO DEC(j) END;
  203.    IF i<=j THEN
  204.       y:=Wt[i];     Ind:=FI[i];
  205.       Wt[i]:=Wt[j]; FI[i]:=FI[j];
  206.       Wt[j]:=y;     FI[j]:=Ind;
  207.       INC(i);        DEC(j);
  208.    END;
  209.  UNTIL i>j;
  210.  IF l<j THEN QuickSort(l,j,Wt,FI) END;
  211.  IF l<r THEN QuickSort(i,r,Wt,FI) END;
  212. END QuickSort;
  213.  
  214. PROCEDURE RechneARInt(VAR WP:Ecken;VAR P1,P2,P3,P4,Pen:INTEGER);
  215. (* Berechnet die Animationssequenz im voraus und speichert alles in ARInt *)
  216. VAR j :INTEGER;
  217. BEGIN
  218.   ARInt[I1]:=Pen;INC(I1);
  219.   ARInt[I1]:=INTEGER(WP[P1][1]*(ZFocus-WP[P1][3])/ZFocus
  220.                 +RGDelta*WP[P1][3]+0.5)+XShift; INC(I1);
  221.   ARInt[I1]:=INTEGER(WP[P1][2]*(ZFocus-WP[P1][3])/ZFocus) DIV 2 +YShift;INC(I1);
  222.   ARInt[I1]:=INTEGER(WP[P2][1]*(ZFocus-WP[P2][3])/ZFocus
  223.                 +RGDelta*WP[P2][3]+0.5)+XShift; INC(I1);
  224.   ARInt[I1]:=INTEGER(WP[P2][2]*(ZFocus-WP[P2][3])/ZFocus) DIV 2 +YShift;INC(I1);
  225.   ARInt[I1]:=INTEGER(WP[P3][1]*(ZFocus-WP[P3][3])/ZFocus
  226.                 +RGDelta*WP[P3][3]+0.5)+XShift; INC(I1);
  227.   ARInt[I1]:=INTEGER(WP[P3][2]*(ZFocus-WP[P3][3])/ZFocus) DIV 2 +YShift;INC(I1);
  228.   ARInt[I1]:=INTEGER(WP[P4][1]*(ZFocus-WP[P4][3])/ZFocus
  229.                 +RGDelta*WP[P4][3]+0.5)+XShift; INC(I1);
  230.   ARInt[I1]:=INTEGER(WP[P4][2]*(ZFocus-WP[P4][3])/ZFocus) DIV 2 +YShift;
  231.   IF I1<108*rotsteps  THEN INC(I1)
  232.                       ELSE  I1:=1
  233.   END;
  234. END RechneARInt;
  235.  
  236. BEGIN
  237.   I1:=1; RGDelta:=0.04;
  238.  
  239. (* Definition der Würfelflächen anhand der aufspannenden Ecken *)
  240.   F[1][1]:=1; F[1][2]:=2; F[1][3]:=3; F[1][4]:=4; F[1][5]:=5;
  241.   F[2][1]:=1; F[2][2]:=2; F[2][3]:=6; F[2][4]:=5; F[2][5]:=5;
  242.   F[3][1]:=2; F[3][2]:=3; F[3][3]:=7; F[3][4]:=6; F[3][5]:=10;
  243.   F[4][1]:=1; F[4][2]:=4; F[4][3]:=8; F[4][4]:=5; F[4][5]:=5;
  244.   F[5][1]:=3; F[5][2]:=4; F[5][3]:=8; F[5][4]:=7; F[5][5]:=5;
  245.   F[6][1]:=5; F[6][2]:=6; F[6][3]:=7; F[6][4]:=8; F[6][5]:=10;
  246.  
  247. (* Koordinaten der Würfelecken im KO-System 2;
  248.    KO-System 1: Ursprung: linke obere Bildschirmecke;
  249.                 x-Achse: oberer Bildschirmrand links -> rechts;
  250.                 y-Achse: linker Bildschirmrand oben -> unten;
  251.                 z-Achse: in Blickrichtung in den Bildschirm hinein
  252. KO-System 2: geht aus KO-System 1 durch Drehung um alfa um die x-Achse hervor *)
  253.  
  254.   WP1org[1,1]:=-1.5; WP1org[1,2]:= 1.0; WP1org[1,3]:=-1.0;
  255.   WP1org[2,1]:=-3.5; WP1org[2,2]:= 1.0; WP1org[2,3]:=-1.0;
  256.   WP1org[3,1]:=-3.5; WP1org[3,2]:=-1.0; WP1org[3,3]:=-1.0;
  257.   WP1org[4,1]:=-1.5; WP1org[4,2]:=-1.0; WP1org[4,3]:=-1.0;
  258.   WP1org[5,1]:=-1.5; WP1org[5,2]:= 1.0; WP1org[5,3]:= 1.0;
  259.   WP1org[6,1]:=-3.5; WP1org[6,2]:= 1.0; WP1org[6,3]:= 1.0;
  260.   WP1org[7,1]:=-3.5; WP1org[7,2]:=-1.0; WP1org[7,3]:= 1.0;
  261.   WP1org[8,1]:=-1.5; WP1org[8,2]:=-1.0; WP1org[8,3]:= 1.0;
  262.   FOR i:=1 TO 8 DO
  263.       WP2org[i][1]:=WP1org[i][1]+5.0;
  264.       WP2org[i][2]:=WP1org[i][2]; WP2org[i][3]:=WP1org[i][3];
  265.   END;
  266.  
  267. (* Vergrößerungsfaktor anbringen *)
  268.   FOR i:=1 TO 8 DO  FOR j:=1 TO 3 DO
  269.       WP1org[i,j]:=WP1org[i,j]*45.0; WP2org[i,j]:=WP2org[i,j]*45.0;
  270.   END; END;
  271.  
  272. (* Koordinaten in KO-System 1 umrechnen *)
  273.   Trafo[1,1]:= 1.0; Trafo[1,2]:= 0.0;       Trafo[1,3]:= 0.0;
  274.   Trafo[2,1]:= 0.0; Trafo[2,2]:= cos(alfa); Trafo[2,3]:=-sin(alfa);
  275.   Trafo[3,1]:= 0.0; Trafo[3,2]:= sin(alfa); Trafo[3,3]:= cos(alfa);
  276.   FOR i:=1 TO 8 DO FOR j:=1 TO 3 DO
  277.       WP1[i,j]:=0.0; WP2[i,j]:=0.0;
  278.   END; END;
  279.   FOR i:=1 TO 8 DO FOR j:=1 TO 3 DO FOR k:=1 TO 3 DO
  280.       WP1[i,j]:=WP1[i,j]+Trafo[j,k]*WP1org[i,k];
  281.       WP2[i,j]:=WP2[i,j]+Trafo[j,k]*WP2org[i,k];
  282.   END; END; END;
  283.   FOR i:=1 TO 8 DO FOR j:=1 TO 3 DO
  284.       WP1org[i,j]:=WP1[i,j]; WP2org[i,j]:=WP2[i,j];
  285.   END; END;
  286.  
  287. (* Matrix für die Rotation der Würfel um dphi um die z-Achse von KO-System 2 *)
  288.   Trafo[1,1]:= cos(dphi);
  289.        Trafo[1,2]:= cos(alfa)*sin(dphi);
  290.             Trafo[1,3]:= sin(dphi)*sin(alfa);
  291.   Trafo[2,1]:= -cos(alfa)*sin(dphi);
  292.        Trafo[2,2]:= cos(alfa)*cos(alfa)*cos(dphi)+sin(alfa)*sin(alfa);
  293.             Trafo[2,3]:= cos(alfa)*cos(dphi)*sin(alfa)-sin(alfa)*cos(alfa);
  294.   Trafo[3,1]:=-sin(alfa)*sin(dphi);
  295.        Trafo[3,2]:= sin(alfa)*cos(alfa)*cos(dphi)-cos(alfa)*sin(alfa);
  296.             Trafo[3,3]:= sin(alfa)*sin(alfa)*cos(dphi)+cos(alfa)*cos(alfa);
  297.  
  298.   FOR m:=1 TO rotsteps DO
  299.  
  300. (* neue Koordinaten nach der Rotation um dphi berechnen *)
  301.     FOR i:=1 TO 8 DO FOR j:=1 TO 3 DO
  302.         WP1[i,j]:=0.0; WP2[i,j]:=0.0;
  303.     END; END;
  304.     FOR i:=1 TO 8 DO FOR j:=1 TO 3 DO FOR k:=1 TO 3 DO
  305.           WP1[i,j]:=WP1[i,j]+Trafo[j,k]*WP1org[i,k];
  306.           WP2[i,j]:=WP2[i,j]+Trafo[j,k]*WP2org[i,k];
  307.     END; END; END;
  308.     FOR i:=1 TO 8 DO FOR j:=1 TO 3 DO
  309.         WP1org[i,j]:=WP1[i,j]; WP2org[i,j]:=WP2[i,j];
  310.     END; END;
  311.  
  312. (* Abstand der Flächenzentren vom Betrachter berechnen *)
  313.     FOR i:=1 TO 6 DO
  314.         j:=F[i,1]; k:=F[i,3];
  315.         ZFCW1[i]:=(WP1[j,1]+WP1[k,1])*(WP1[j,1]+WP1[k,1])+
  316.                   (WP1[j,2]+WP1[k,2])*(WP1[j,2]+WP1[k,2])+
  317.                   (WP1[j,3]+WP1[k,3]+50.0*ZFocus)*
  318.                   (WP1[j,3]+WP1[k,3]+50.0*ZFocus);
  319.         ZFCW2[i]:=(WP2[j,1]+WP2[k,1])*(WP2[j,1]+WP2[k,1])+
  320.                   (WP2[j,2]+WP2[k,2])*(WP2[j,2]+WP2[k,2])+
  321.                   (WP2[j,3]+WP2[k,3]+50.0*ZFocus)*
  322.                   (WP2[j,3]+WP2[k,3]+50.0*ZFocus);
  323.     END;
  324.     FOR i:=1 TO 6 DO FIndexW1[i]:=i; FIndexW2[i]:=i; END;
  325.  
  326. (* Flächen für Hiddenline-Darstellung sortieren *)
  327.     QuickSort(1,6,ZFCW1,FIndexW1); QuickSort(1,6,ZFCW2,FIndexW2);
  328.  
  329.     n:=1;
  330.     RGDelta:=-RGDelta;
  331.  
  332. (* für beide Würfel die sichtbaren drei Flächen im Anim-speicher ablegen *)
  333.     LOOP
  334.       IF ZFCW2[1]<ZFCW1[1] THEN
  335.          FOR i:=3 TO 1 BY -1 DO
  336.              j:=FIndexW1[i];
  337.          RechneARInt(WP1org,F[j,1],F[j,2],F[j,3],F[j,4],F[j,5]);
  338.      END;
  339.      FOR i:=3 TO 1 BY -1 DO
  340.              j:=FIndexW2[i];
  341.          RechneARInt(WP2org,F[j,1],F[j,2],F[j,3],F[j,4],F[j,5]);
  342.      END;
  343.       ELSE
  344.          FOR i:=3 TO 1 BY -1 DO
  345.              j:=FIndexW2[i];
  346.          RechneARInt(WP2org,F[j,1],F[j,2],F[j,3],F[j,4],F[j,5]);
  347.      END;
  348.      FOR i:=3 TO 1 BY -1 DO
  349.              j:=FIndexW1[i];
  350.          RechneARInt(WP1org,F[j,1],F[j,2],F[j,3],F[j,4],F[j,5]);
  351.      END;
  352.       END;
  353.  
  354.       IF n=2 THEN
  355.            EXIT
  356.       ELSE
  357.            INC(n); RGDelta:=-RGDelta;
  358.       END;
  359.     END;
  360.   END;
  361.  
  362.   n:=1;
  363.   SetWrMsk(RGRPPtr,0FFH); SetRast(RGRPPtr,0);
  364.   m:=-8;
  365.  
  366. (* Animation zeichnen *)
  367.   LOOP
  368.      INC(m,9);
  369.      IF m+8>108*rotsteps THEN m:=1 END;
  370.      IF (n=1)  THEN SetWrMsk(RGRPPtr,0F3H);SetOPen(RGRPPtr,10); END;
  371.      IF (n=7)  THEN SetWrMsk(RGRPPtr,0FCH);SetOPen(RGRPPtr,10); END;
  372.      FOR j:=0 TO 49 DO Buffer[j]:=0;END;
  373.      SetAPen(RGRPPtr,ARInt[m]);
  374.      ok:=AreaMove(RGRPPtr,ARInt[m+1],ARInt[m+2]);
  375.      ok:=AreaDraw(RGRPPtr,ARInt[m+3],ARInt[m+4]);
  376.      ok:=AreaDraw(RGRPPtr,ARInt[m+5],ARInt[m+6]);
  377.      ok:=AreaDraw(RGRPPtr,ARInt[m+7],ARInt[m+8]);
  378.      ok:=AreaEnd(RGRPPtr);
  379.      IF (n=12) THEN
  380.        n:=0;
  381.        IF (RGRPPtr=RGWinRPPtr1) THEN
  382.            RGRPPtr:=RGWinRPPtr0;ScreenToFront(RGScreenPtr1);
  383.        ELSE
  384.            RGRPPtr:=RGWinRPPtr1;ScreenToFront(RGScreenPtr0);
  385.        END;
  386.        SetWrMsk(RGRPPtr,0FFH); SetRast(RGRPPtr,0);
  387.      END;
  388.      INC(n);
  389.  
  390.      EX:=FALSE;
  391.      IF (RGWindowPtr0 # NIL) THEN
  392.         IntuiMsg:=GetMsg(RGWindowPtr0^.userPort);
  393.         WHILE IntuiMsg#NIL DO
  394.             class:=IntuiMsg^.class; ReplyMsg(IntuiMsg);
  395.             IF (closeWindow IN class) THEN EX:=TRUE;END;
  396.             IntuiMsg:=GetMsg(RGWindowPtr0^.userPort);
  397.         END;
  398.      END;
  399.      IF (RGWindowPtr1 # NIL) THEN
  400.         IntuiMsg:=GetMsg(RGWindowPtr1^.userPort);
  401.         WHILE IntuiMsg#NIL DO
  402.             class:=IntuiMsg^.class; ReplyMsg(IntuiMsg);
  403.             IF (closeWindow IN class) THEN EX:=TRUE;END;
  404.             IntuiMsg:=GetMsg(RGWindowPtr1^.userPort);
  405.         END;
  406.      END;
  407.      IF EX THEN EXIT;END;
  408.   END;
  409. END AnimWuerfel;
  410.  
  411. BEGIN
  412.   WriteString("Rot-Grün-3D-Demo Version 1.0,");WriteLn;
  413.   WriteString("Copyright: Bernfried Brüggemann, Munich 22.04.92");WriteLn;
  414.   TermProcedure(CloseDown);
  415.   InitOberfl;
  416.   FarbTabelleLaden;
  417.   ScheibenZeichnen;
  418.   AnimWuerfel;
  419. END RGDemo.
  420.